home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / archival / mirror-2.1 / lsparse.pl < prev    next >
Encoding:
Perl Script  |  1993-06-28  |  13.6 KB  |  569 lines
  1. #-*-perl-*-
  2. # Parse "ls -lR" type listings
  3. # use lsparse'reset( dirname ) repeately
  4. # By Lee McLoughlin <lmjm@doc.ic.ac.uk>
  5. #
  6. # $Id: lsparse.pl,v 2.1 1993/06/28 15:03:08 lmjm Exp lmjm $
  7. # $Log: lsparse.pl,v $
  8. # Revision 2.1  1993/06/28  15:03:08  lmjm
  9. # Full 2.1 release
  10. #
  11. #
  12.  
  13. # This has better be available via your PERLLIB environment variable
  14. require 'dateconv.pl';
  15.  
  16. package lsparse;
  17.  
  18. # The current directory is stripped off the
  19. # start of the returned pathname
  20. # $match is a pattern that matches this
  21. local( $match );
  22.  
  23. # The filestore type being scanned
  24. $lsparse'fstype = 'unix';
  25.  
  26. # Keep whatever case is on the remote system.  Otherwise lowercase it.
  27. $lsparse'vms_keep_case = '';
  28.  
  29. # A name to report when errors occur
  30. $lsparse'name = 'unknown';
  31.  
  32. # Name of routine to call to parse incoming listing lines
  33. $ls_line = '';
  34.  
  35. # Set the directory that is being scanned and
  36. # check that the scan routing for this fstype exists
  37. # returns false if the fstype is unknown.
  38. sub lsparse'reset
  39. {
  40.     $here = $currdir = @_[0];
  41.     $now = time;
  42.     # Vms tends to give FULL pathnames reguardless of where
  43.     # you generate the dir listing from.
  44.     $vms_strip = $currdir;
  45.     $vms_strip =~ s,^/+,,;
  46.     $vms_strip =~ s,/+$,,;
  47.  
  48.     $ls_line = "lsparse'line_$fstype";
  49.     return( defined( &$ls_line ) );
  50. }
  51.  
  52. # See line_unix following routine for call/return details.
  53. # This calls the filestore specific parser.
  54. sub lsparse'line
  55. {
  56.     # ls_line is setup in lsparse'reset to the name of the function
  57.     local( $path, $size, $time, $type, $mode ) =
  58.         eval "&$ls_line( @_ )";
  59.  
  60.     # Zap any leading ./  (Somehow they still creep thru.)
  61.     $path =~ s:^(\./)+::;
  62.     return ($path, $size, $time, $type, $mode);
  63. }
  64.  
  65. # --------------------- parse standard Unix ls output
  66. # for each file or directory line found return a tuple of
  67. # (pathname, size, time, type, mode)
  68. # pathname is a full pathname relative to the directory set by reset()
  69. # size is the size in bytes (this is always 0 for directories)
  70. # time is a Un*x time value for the file
  71. # type is "f" for a file, "d" for a directory and
  72. #         "l linkname" for a symlink
  73. sub lsparse'line_unix
  74. {
  75.     local( $fh ) = @_;
  76.     local( $non_crud, $perm_denied );
  77.  
  78.     if( eof( $fh ) ){
  79.         return( "", 0, 0, 0 );
  80.     }
  81.  
  82.     while( <$fh> ){
  83.         # Stomp on carriage returns
  84.         s/\015//g;
  85.  
  86.         # I'm about to look at this at lot
  87.         study;
  88.  
  89.         # Try and spot crud in the line and avoid it
  90.         # You can get:
  91.         # -rw-r--r-ls: navn/internett/RCS/nsc,v: Permission denied
  92.         # ls: navn/internett/RCS/bih,v: Permission denied
  93.         # -  1 43       daemon       1350 Oct 28 14:03 sognhs
  94.         # -rwcannot access .stuff/incoming
  95.         # cannot access .stuff/.cshrc
  96.         if( m%^(.*)/bin/ls:.*Permission denied% ||
  97.            m%^(.*)ls:.*Permission denied% ||
  98.            m%^(.*)(cannot|can not) access % ){
  99.             if( ! $non_crud ){
  100.                 $non_crud = $1;
  101.             }
  102.             next;
  103.         }
  104.         # Also try and spot non ls "Permission denied" messages.  These
  105.         # are a LOT harder to handle as the key part is at the end
  106.         # of the message.  For now just zap any line containing it
  107.         # and the first line following (as it will PROBABLY have been broken).
  108.         #
  109.         if( /.:\s*Permission denied/ ){
  110.             $perm_denied = 1;
  111.             next;
  112.         }
  113.         if( $perm_denied ){
  114.             $perm_denied = "";
  115.             warn "Warning: input corrupted by 'Permission denied'",
  116.                 "errors, about line $. of $lsparse'name\n";
  117.             next;
  118.         }
  119.         # Not found's are like Permission denied's.  They can start part
  120.         # way through a line but with no way of spotting where they begin
  121.         if( /not found/ ){
  122.             $not_found = 1;
  123.             next;
  124.         }
  125.         if( $not_found ){
  126.             $not_found = "";
  127.             warn "Warning: input corrupted by 'not found' errors",
  128.                 " about line $. of $lsparse'name\n";
  129.             next;
  130.         }
  131.         
  132.         if( $non_crud ){
  133.             $_ = $non_crud . $_;
  134.             $non_crud = "";
  135.         }
  136.         
  137.         if( /^([\-lrwxsSt]{10}).*\s(\d+)\s*(\w\w\w\s+\d+\s*(\d+:\d+|\d\d\d\d))\s+(.*)\n/ ){
  138.             local( $kind, $size, $lsdate, $file ) = ($1, $2, $3, $5);
  139.             
  140.             if( $file eq '.' || $file eq '..' ){
  141.                 next;
  142.             }
  143.  
  144.             local( $time ) = &main'lstime_to_time( $lsdate );
  145.             local( $type ) = '?';
  146.             local( $mode ) = 0;
  147.  
  148.             # This should be a symlink
  149.             if( $kind =~ /^l/ && $file =~ /(.*) -> (.*)/ ){
  150.                 $file = $1;
  151.                 $type = "l $2";
  152.             }
  153.             elsif( $kind =~ /^-/ ){
  154.                 # (hopefully) a regular file
  155.                 $type = 'f';
  156.             }
  157.             
  158.             $mode = &chars_to_mode( $kind );
  159.  
  160.             $currdir =~ s,/+,/,g;
  161.             $file =~ s,^/$match,,;
  162.             $file = "/$currdir/$file";
  163.             $file =~ s,/+,/,g;
  164.             return( substr( $file, 1 ), $size, $time, $type, $mode );
  165.         }
  166.         # Match starts of directories.  Try not to match
  167.         # directories whose naes ending in :
  168.         elsif( /^([\.\/]*.*):$/ && ! /^[dcbsp].*\s.*\s.*:$/ ){
  169.             if( $1 eq '.' ){
  170.                 next;
  171.             }
  172.             elsif( $1 !~ /^\// ){
  173.                 $currdir = "$here/$1";
  174.             }
  175.             else {
  176.                 $currdir = "$1";
  177.             }
  178.             $currdir =~ s,/+,/,g;
  179.             $match = $currdir;
  180.             $match =~ s/([\+\(\)\[\]\*\?])/\\$1/g;
  181.             return( substr( $currdir, 1 ), 0, 0, 'd', 0 );
  182.         }
  183.         elsif( /^[dcbsp].*[^:]$/ || /^\s*$/ || /^[Tt]otal.*/ || /[Uu]nreadable$/ ){
  184.             ;
  185.         }
  186.         elsif( /^.*[Uu]pdated.*:/ ){
  187.             # Probably some line like:
  188.             # Last Updated:  Tue Oct  8 04:30:50 EDT 1991
  189.             # skip it
  190.             next;
  191.         }
  192.         elsif( /^([\.\/]*[^\s]*)/ ){
  193.             # Just for the export.lcs.mit.edu ls listing
  194.             $match = $currdir = "$1/";
  195.             $match =~ s/[\+\(\[\*\?]/\\$1/g;
  196.         }        
  197.         else {
  198.             printf( "Unmatched line: %s", $_ );
  199.         }
  200.     }
  201.     return( '', 0, 0, 0, 0 );
  202. }
  203.  
  204. # Convert the mode chars at the start of an ls-l entry into a number
  205. sub chars_to_mode
  206. {
  207.     local( $chars ) = @_;
  208.     local( @kind, $c );
  209.  
  210.     # Split and remove first char
  211.     @kind = split( //, $kind );
  212.     shift( @kind );
  213.  
  214.     foreach $c ( @kind ){
  215.         $mode <<= 1;
  216.         if( $c ne '-' && $c ne 'S' && $c ne 'T' ){
  217.             $mode |= 1;
  218.         }
  219.     }
  220.  
  221.     # check for "special" bits
  222.  
  223.     # uid bit
  224.     if( /^...s....../i ){
  225.         $mode |= 04000;
  226.     }
  227.  
  228.     # gid bit
  229.     if( /^......s.../i ){
  230.         $mode |= 02000;
  231.     }
  232.  
  233.     # sticky bit
  234.     if( /^.........t/i ){
  235.         $mode |= 01000;
  236.     }
  237.  
  238.     return $mode;
  239. }
  240.  
  241. # --------------------- parse dls output
  242.  
  243. # dls is a descriptive ls that some sites use.
  244. # this parses the output of dls -dtR
  245.  
  246. # for each file or directory line found return a tuple of
  247. # (pathname, size, time, type, mode)
  248. # pathname is a full pathname relative to the directory set by reset()
  249. # size is the size in bytes (this is always 0 for directories)
  250. # time is a Un*x time value for the file
  251. # type is "f" for a file, "d" for a directory and
  252. #         "l linkname" for a symlink
  253. sub lsparse'line_dls
  254. {
  255.     local( $fh ) = @_;
  256.     local( $non_crud, $perm_denied );
  257.  
  258.     if( eof( $fh ) ){
  259.         return( "", 0, 0, 0 );
  260.     }
  261.  
  262.     while( <$fh> ){
  263.         # Stomp on carriage returns
  264.         s/\015//g;
  265.  
  266.         # I'm about to look at this at lot
  267.         study;
  268.  
  269.         if( /^(\S*)\s+(\-|\=|\d+)\s+((\w\w\w\s+\d+|\d+\s+\w\w\w)\s+(\d+:\d+|\d\d\d\d))\s+(.+)\n/ ){
  270.             local( $file, $size, $lsdate, $description ) =
  271.                 ($1, $2, $3, $6);
  272.             $file =~ s/\s+$//;
  273.             local( $time, $type, $mode );
  274.             
  275.             if( $file =~ m|/$| ){
  276.                 # a directory
  277.                 $file =~ s,/$,,;
  278.                 $time = 0;
  279.                 $type = 'd';
  280.                 $mode = 0555;
  281.             }
  282.             else {
  283.                 # a file
  284.                 $time = &main'lstime_to_time( $lsdate );
  285.                 $type = 'f';
  286.                 $mode = 0444;
  287.             }
  288.  
  289.             # Handle wrapped long filenames
  290.             if( $filename ne '' ){
  291.                 $file = $filename;
  292.             }
  293.             $filename = '';
  294.  
  295.             $file =~ s/\s*$//;
  296.             $file = "$currdir/$file";
  297.             $file =~ s,/+,/,g;
  298.             return( substr( $file, 1 ), $size, $time, $type, $mode );
  299.         }
  300.         elsif( /^(.*):$/ ){
  301.             if( $1 eq '.' ){
  302.                 next;
  303.             }
  304.             elsif( $1 !~ /^\// ){
  305.                 $currdir = "$here/$1/";
  306.             }
  307.             else {
  308.                 $currdir = "$1/";
  309.             }
  310.             $filename = '';
  311.             $currdir =~ s,/+,/,g;
  312.             $match = $currdir;
  313.             $match =~ s/([\+\(\)\[\]\*\?])/\\$1/g;
  314.             return( substr( $currdir, 1 ), 0, 0, 'd', 0 );
  315.         }
  316.         else {
  317.             # If a filename is long then it is on a line by itself
  318.             # with the details on the next line
  319.             chop( $filename = $_ );
  320.         }
  321.     }
  322.     return( '', 0, 0, 0, 0 );
  323. }
  324.  
  325. # --------------------- parse netware output
  326.  
  327. # For each file or directory line found return a tuple of
  328. # (pathname, size, time, type, mode)
  329. # pathname is a full pathname relative to the directory set by reset()
  330. # size is the size in bytes (this is always 0 for directories)
  331. # time is a Un*x time value for the file
  332. # type is "f" for a file, "d" for a directory and
  333. #         "l linkname" for a symlink
  334. sub lsparse'line_netware
  335. {
  336.     local( $fh ) = @_;
  337.  
  338.     if( eof( $fh ) ){
  339.         return( "", 0, 0, 0 );
  340.     }
  341.  
  342.     while( <$fh> ){
  343.         # Stomp on carriage returns
  344.         s/\015//g;
  345. # Unix vs NetWare:
  346. #1234567890 __________.*_____________ d+  www dd  dddd (.*)\n
  347. #drwxr-xr-x   2 jrd      other        512 Feb 29  1992 vt100
  348. #   kind                       size lsdate       file
  349. #123456789012sw+ ____.*_______\s+(\d+)   \s+  wwwsddsdd:dd\s+ (.*)\n  
  350. #- [R----F--] jrd                197928       Sep 25 15:19    kermit.exe
  351. #d [R----F--] jrd                   512       Oct 06 09:31    source
  352. #d [RWCEAFMS] jrd                   512       Sep 04 14:38    lwp
  353.  
  354.         if( /^([d|l|\-]\s\[[RWCEAFMS\-]{8}\])\s\w+\s+(\d+)\s*(\w\w\w\s+\d+\s*(\d+:\d+|\d\d\d\d))\s+(.*)\n/) {
  355.             local( $kind, $size, $lsdate, $file ) =
  356.                          ( $1, $2, $3, $5);
  357.             if( $file eq '.' || $file eq '..' ){
  358.                 next;
  359.             }
  360.             local( $time ) = &main'lstime_to_time( $lsdate );
  361.             local( $type ) = '?';
  362.             local( $mode ) = 0;
  363.  
  364.             # This should be a symlink
  365.             if( $kind =~ /^l/ && $file =~ /(.*) -> (.*)/ ){
  366.                 $file = $1;
  367.                 $type = "l $2";
  368.             }
  369.             elsif( $kind =~ /^-/ ){
  370.                 # (hopefully) a regular file
  371.                 $type = 'f';
  372.             }
  373.             
  374.             $mode = &netware_to_mode( $kind );
  375.  
  376.             if( $kind =~ /^d/ ) {
  377.                 # a directory
  378.                 $type = 'd';
  379.                 $size = 0;   # Don't believe the report size
  380.             }
  381.             $currdir =~ s,/+,/,g;
  382.             $file =~ s,^/$match,,;
  383.             $file = "/$currdir/$file";
  384.             $file =~ s,/+,/,g;
  385.             return( substr( $file, 1 ), $size, $time, $type, $mode );
  386.         }
  387.  
  388.         elsif( /^[dcbsp].*[^:]$/ || /^\s*$/ || /^[Tt]otal.*/ || /[Uu]nreadable$/ ){
  389.             ;
  390.         }
  391.         elsif( /^.*[Uu]pdated.*:/ ){
  392.             # Probably some line like:
  393.             # Last Updated:  Tue Oct  8 04:30:50 EDT 1991
  394.             # skip it
  395.             next;
  396.         }
  397.         else {
  398.             printf( "Unmatched line: %s", $_ );
  399.             return( '', 0, 0, 0, 0 );
  400.         }
  401.     }
  402.     return( '', 0, 0, 0, 0 );
  403. }
  404.  
  405. # Convert NetWare file access mode chars at the start of a DIR entry 
  406. # into a Unix access number.
  407. sub netware_to_mode
  408. {
  409.     local( $chars ) = @_;
  410.     local( @kind, $c );
  411.  
  412.     # Split and remove first three characters
  413.     @kind = split( //, $kind );
  414.     shift( @kind );        # omit directory "d" field
  415.     shift( @kind );        # omit space separator
  416.     shift( @kind );        # omit left square bracket
  417.     $mode = 0;        # init $mode to no access
  418.  
  419.     foreach $c ( @kind ){
  420.         if( $c eq 'R' )    {$mode |= 0x644;}    ## r/w r r
  421.         if( $c eq 'W' ) {$mode |= 0x222;}    ## w   w w
  422.         if( $c eq 'F' ) {$mode |= 0x444;}    ## r   r r
  423.         }
  424.     return $mode;
  425. }
  426. # --------------------- parse VMS dir output
  427. # for each file or directory line found return a tuple of
  428. # (pathname, size, time, type, mode)
  429. # pathname is a full pathname relative to the directory set by reset()
  430. # size is the size in bytes (this is always 0 for directories)
  431. # time is a Un*x time value for the file
  432. # type is "f" for a file, "d" for a directory and
  433. #         "l linkname" for a symlink
  434. sub lsparse'line_vms
  435. {
  436.     local( $fh ) = @_;
  437.     local( $non_crud, $perm_denied );
  438.  
  439.     if( eof( $fh ) ){
  440.         return( "", 0, 0, 0 );
  441.     }
  442.  
  443.     while( <$fh> ){
  444.         # Stomp on carriage returns
  445.         s/\015//g;
  446.  
  447.         # I'm about to look at this at lot
  448.         study;
  449.  
  450.         if( /^\s*$/ ){
  451.             next;
  452.         }
  453.  
  454.         if( /^\s*Total of/i ){
  455.             # Just a size report ignore
  456.             next;
  457.         }
  458.  
  459.         if( /\%RMS-E-PRV|insufficient privilege/i ){
  460.             # A permissions error - skip the line
  461.             next;
  462.         }
  463.  
  464.         # Upper case is so ugly
  465.         if( ! $lsparse'vms_keep_case ){
  466.             tr/A-Z/a-z/;
  467.         }
  468.  
  469.         # DISK$ANON:[ANONYMOUS.UNIX]
  470.         if( /^([^:]+):\[([^\]+]+)\]\s*$/ ){
  471.             # The directory name
  472.             # Use the Unix convention of /'s in filenames not
  473.             # .'s
  474.             $currdir = '/' . $2;
  475.             $currdir =~ s,\.,/,g;
  476.             $currdir =~ s,/+,/,g;
  477.             $currdir =~ s,^/$vms_strip,,;
  478.             if( $currdir eq '' ){
  479.                 next;
  480.             }
  481.             $match = $currdir;
  482.             $match =~ s/([\+\(\)\[\]\*\?])/\\$1/g;
  483. #print ">>>match=$match currdir=$currdir\n";
  484.             return( substr( $currdir, 1 ), 0, 0, 'd', 0 );
  485.         }
  486.         
  487.     # MultiNet FTP
  488.     # DSPD.MAN;1  9   1-APR-1991 12:55 [SG,ROSENBLUM] (RWED,RWED,RE,RE)
  489.     # CMU/VMS-IP FTP
  490.     # [VMSSERV.FILES]ALARM.DIR;1      1/3          5-MAR-1993 18:09
  491.         local( $dir, $file, $vers, $size, $lsdate, $got );
  492.         $got = 0;
  493.         # For now ignore user and mode
  494.         if( /^((\S+);(\d+))?\s+(\d+)\s+(\d+-\S+-\d+\s+\d+:\d+)/ ){
  495.             ($file, $vers, $size, $lsdate) = ($2,$3,$4,$5);
  496.             $got = 1;
  497.         }
  498.         elsif( /^(\[([^\]]+)\](\S+);(\d+))?\s+\d+\/\d+\s+(\d+-\S+-\d+\s+\d+:\d+)\s*$/ ){
  499.             ($dir,$file,$vers,$lsdate) = ($2,$3,$4,$5);
  500.             $got = 1;
  501.         }
  502.         # The sizes mean nothing under unix...
  503.         $size = 0;
  504.         
  505.         if( $got ){
  506.             local( $time ) = &main'lstime_to_time( $lsdate );
  507.             local( $type ) = 'f';
  508.             local( $mode ) = 0444;
  509.  
  510.             # Handle wrapped long filenames
  511.             if( $filename ne '' ){
  512.                 $file = $filename;
  513.                 $vers = $version;
  514.                 if( $directory ){
  515.                     $dir = $directory;
  516.                 }
  517.             }
  518.             if( defined( $dir ) ){
  519.                 $dir =~ s/\./\//g;
  520.                 $file = $dir . '/' . $file;
  521.             }
  522.             $filename = '';
  523.  
  524.             if( $file =~ /^(.*)\.dir(;\d+)?$/ ){
  525.                 if( ! $vms_keep_dotdir ){
  526.                     $file = $1 . $2;
  527.                 }
  528.                 $type = 'd';
  529.                 $mode = 0555;
  530.             }
  531.  
  532.             $lsparse'vers = $vers;
  533.  
  534. #print "file=|$file| match=|$match| vms_strip=|$vms_strip|\n";
  535.             $file =~ s,^,/,;
  536.             $file =~ s,^/$match,,;
  537.             if( ! defined( $dir ) ){
  538.                 $file = "$currdir/$file";
  539.             }
  540.             $file =~ s,^$vms_strip,,;
  541.             $file =~ s,/+,/,g;
  542. #print  "file=|$file|\n";
  543.             return( substr( $file, 1 ), $size, $time, $type, $mode );
  544.         }
  545.         elsif( /^\[([^\]]+)\](\S+);(\d+)\s*$/ ){
  546.             # If a filename is long then it is on a line by itself
  547.             # with the details on the next line
  548.             local( $d, $f, $v ) = ($1, $2, $3);
  549.             $d =~ s/\./\//g;
  550.             $directory = $d;
  551.             $filename = $f;
  552.             $version = $v;
  553.         }
  554.         elsif( /^(\S+);(\d+)\s*$/ ){
  555.             # If a filename is long then it is on a line by itself
  556.             # with the details on the next line
  557.             $filename = $1;
  558.             $version = $2;
  559.         }
  560.         else {
  561.             printf( "Unmatched line: %s", $_ );
  562.         }
  563.     }
  564.     return( '', 0, 0, 0, 0 );
  565. }
  566.  
  567. # -----
  568. 1;
  569.